home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG10.ZIP / 3D1.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-08-25  |  6.2 KB  |  165 lines
  1.                Program WireFrame;
  2.  
  3.                Uses Mode13h,Crt;
  4.  
  5.                Const MaxPoints=30;
  6.                      MaxLines=30;
  7.  
  8.                Type Point3d=Record
  9.                                   X,Y,Z:Real;
  10.                             End;
  11.  
  12.                     Object3d=Record
  13.                                    NumberPoints:Byte;
  14.                                    NumberLines:Byte;
  15.                                    Pt:Array[1..MaxPoints] Of Point3d;
  16.                                    Lines:Array[1..MaxLines,1..2] Of Byte;
  17.                              End;
  18.  
  19.                Var A:Integer;
  20.                    Cube:Object3d;
  21.                    D:Char;
  22.  
  23.                Procedure Conv3d(X,Y,Z:Real;Var Xt,Yt:Integer);
  24.                Begin
  25.                     Xt:=160+Trunc((X*256)/Z);
  26.                     Yt:=100+Trunc((Y*256)/Z);
  27.                End;
  28.  
  29.                Procedure Load3d(Filename:String;Var Obj:Object3d);
  30.                Var F:Text;
  31.                    A:Byte;
  32.                Begin
  33.                     Assign(F,Filename);
  34.                     Reset(F);
  35.                     ReadLn(F,Obj.NumberPoints);
  36.                     ReadLn(F,Obj.NumberLines);
  37.                     For A:=1 To Obj.NumberPoints Do
  38.                       ReadLn(F,Obj.Pt[A].X,Obj.Pt[A].Y,Obj.Pt[A].Z);
  39.                     For A:=1 To Obj.NumberLines Do
  40.                       ReadLn(F,Obj.Lines[A,1],Obj.Lines[A,2]);
  41.                     Close(F);
  42.                End;
  43.  
  44.                Procedure Draw3d(Obj:Object3d;XOff,YOff,ZOff:Integer;
  45.                                 Color:Byte;Where:Word);
  46.                Var A:Byte;
  47.                    Pt1,Pt2:Byte;
  48.                    X1,Y1,X2,Y2:Integer;
  49.                Begin
  50.                     For A:=1 To Obj.NumberLines Do
  51.                     Begin
  52.                          Pt1:=Obj.Lines[A,1];
  53.                          Pt2:=Obj.Lines[A,2];
  54.                          Conv3d(Obj.Pt[Pt1].X+XOff,
  55.                                 Obj.Pt[Pt1].Y+YOff,
  56.                                 Obj.Pt[Pt1].Z+ZOff,
  57.                                 X1,Y1);
  58.                          Conv3d(Obj.Pt[Pt2].X+XOff,
  59.                                 Obj.Pt[Pt2].Y+YOff,
  60.                                 Obj.Pt[Pt2].Z+ZOff,
  61.                                 X2,Y2);
  62.                          LineC(X1,Y1,X2,Y2,Color,Where);
  63.                     End;
  64.                End;
  65.  
  66.                Procedure Translate(Var Obj:Object3d;XOff,YOff,ZOff:Integer);
  67.                Var A:Byte;
  68.                Begin
  69.                     For A:=1 To Obj.NumberPoints Do
  70.                     Begin
  71.                          Obj.Pt[A].X:=Obj.Pt[A].X+XOff;
  72.                          Obj.Pt[A].Y:=Obj.Pt[A].Y+YOff;
  73.                          Obj.Pt[A].Z:=Obj.Pt[A].Z+ZOff;
  74.                     End;
  75.                End;
  76.  
  77.                Procedure Scale(Var Obj:Object3d;XScl,YScl,ZScl:Real);
  78.                Var A:Byte;
  79.                Begin
  80.                     For A:=1 To Obj.NumberPoints Do
  81.                     Begin
  82.                          Obj.Pt[A].X:=Obj.Pt[A].X*XScl;
  83.                          Obj.Pt[A].Y:=Obj.Pt[A].Y*YScl;
  84.                          Obj.Pt[A].Z:=Obj.Pt[A].Z*ZScl;
  85.                     End;
  86.                End;
  87.  
  88.                Procedure RotateX(Var Obj:Object3d;Deg:Integer);
  89.                Var A:Byte;
  90.                    Angle:Real;
  91.                    ZTemp:Real;
  92.                Begin
  93.                     Angle:=0.0175*Deg;
  94.                     For A:=1 To Obj.NumberPoints Do
  95.                       With Obj.Pt[A] Do
  96.                       Begin
  97.                            ZTemp:=Z;
  98.                            Z:=ZTemp*Cos(Angle)-Y*Sin(Angle);
  99.                            Y:=Y*Cos(Angle)+ZTemp*Sin(Angle);
  100.                       End;
  101.                End;
  102.  
  103.                Procedure RotateY(Var Obj:Object3d;Deg:Integer);
  104.                Var A:Byte;
  105.                    Angle:Real;
  106.                    XTemp:Real;
  107.                Begin
  108.                     Angle:=0.0175*Deg;
  109.                     For A:=1 To Obj.NumberPoints Do
  110.                       With Obj.Pt[A] Do
  111.                       Begin
  112.                            XTemp:=X;
  113.                            X:=XTemp*Cos(Angle)-Z*Sin(Angle);
  114.                            Z:=Z*Cos(Angle)+XTemp*Sin(Angle);
  115.                       End;
  116.                End;
  117.  
  118.                Procedure RotateZ(Var Obj:Object3d;Deg:Integer);
  119.                Var A:Byte;
  120.                    Angle:Real;
  121.                    XTemp:Real;
  122.                Begin
  123.                     Angle:=0.0175*Deg;
  124.                     For A:=1 To Obj.NumberPoints Do
  125.                       With Obj.Pt[A] Do
  126.                       Begin
  127.                            XTemp:=X;
  128.                            X:=XTemp*Cos(Angle)-Y*Sin(Angle);
  129.                            Y:=Y*Cos(Angle)+XTemp*Sin(Angle);
  130.                       End;
  131.                End;
  132.  
  133.                Begin
  134.                     Initgraph;
  135.                     Load3d('Cube.3d',Cube);
  136.                     SetColor(1,63,63,0);
  137.                     Translate(Cube,-40,-50,200);
  138.                     For A:=1 To 72 Do
  139.                     Begin
  140.                          Translate(Cube,40,50,-200);
  141.                          RotateX(Cube,5);
  142.                          Translate(Cube,-40,-50,200);
  143.                          Draw3d(Cube,0,0,0,1,VGA);
  144.                          Draw3d(Cube,0,0,0,0,VGA);
  145.                     End;
  146.                     For A:=1 To 72 Do
  147.                     Begin
  148.                          Translate(Cube,40,50,-200);
  149.                          RotateY(Cube,5);
  150.                          Translate(Cube,-40,-50,200);
  151.                          Draw3d(Cube,0,0,0,1,VGA);
  152.                          Draw3d(Cube,0,0,0,0,VGA);
  153.                     End;
  154.                     For A:=1 To 72 Do
  155.                     Begin
  156.                          Translate(Cube,40,50,-200);
  157.                          RotateZ(Cube,5);
  158.                          Translate(Cube,-40,-50,200);
  159.                          Draw3d(Cube,0,0,0,1,VGA);
  160.                          Draw3d(Cube,0,0,0,0,VGA);
  161.                     End;
  162.                     Draw3d(Cube,0,0,0,1,VGA);
  163.                     D:=Readkey;
  164.                     Closegraph;
  165.                End.